home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Linux Cubed Series 7: Sunsite
/
Linux Cubed Series 7 - Sunsite Vol 1.iso
/
system
/
printing
/
ljetmgr2.4-b
/
ljetmgr2
/
SW
/
lib
/
libtxOption5.2.tsl
< prev
next >
Wrap
Text File
|
1996-06-14
|
4KB
|
96 lines
# RQ tclkit 3
# RQ txLabel 5
# RQ font 2
# +END
# RCS: $Id: option.tcl,v 1.2 1996/05/12 14:52:39 risc Exp $
Require txLabel 5
proc txOption_Init { args } {Require font 2
option add *unit.font [Font get Label] widgetDefault
option add *Menubutton*highlightThickness [Cfg get Tx HilitBorder] widgetDefault
option add *Menubutton*font [Font get Menu] widgetDefault
option add *Menu*background [Cfg get Color MenuBack] widgetDefault
option add *Menu*disabledForeground [Cfg get Color MenuDisabledFore] widgetDefault
option add *Menu*foreground [Cfg get Color MenuFore]
option add *Menu*font [Font get Menu] widgetDefault
option add *Menubutton*selectColor [Cfg get Color MenuSelect] widgetDefault}
tixWidgetClass txOption {-classname TxOption
-superclass txLabel
-method {add
set
get
setname
getname}
-flag {-command
-state
-unit
-unitwidth
-modified}
-forcecall {-variable
-state}
-configspec {{-command command Command {}}
{-disablecallback disableCallback DisableCallback false}
{-state state State normal}
{-unit unit Unit ""}
{-unitwidth unitWidth UnitWidth 0}
{-variable variable Variable ""}
{-modified modified Modified 0}
{-width width Width 10}}}
proc txOption::InitWidgetRec {w} {upvar #0 $w data
tixChainMethod $w InitWidgetRec
set data(nItems) 0
set data(varInited) 0
set data(value) ""}
proc txOption::ConstructWidget {w} {upvar \#0 $w data
tixChainMethod $w ConstructWidget
set data(w:menubutton) [menubutton $w.menubutton -indicatoron 1 -width $data(-width) -relief raised -borderwidth 2 -takefocus 1 ]
set data(w:menu) [menu $w.menubutton.menu -tearoff 0 ]
$data(w:menubutton) config -menu $data(w:menu)
grid $data(w:menubutton) -row 1 -column 1 -sticky ew
grid columnconfigure $w 1 -weight 100
grid rowconfigure $w 1 -weight 100
set data(w:unit) [label $w.unit -text $data(-unit) -width $data(-unitwidth) -anchor w ]
if { $data(-unit)!="" } {grid $data(w:unit) -row 1 -column 2 -sticky we
grid columnconfigure $w 2 -weight 0}}
proc txOption::SetBindings {w} {upvar #0 $w data
tixChainMethod $w SetBindings
bindtags $data(w:menubutton) [concat $data(ClassName) [bindtags $data(w:menubutton)] ]
bind $data(w:menubutton) <Up> [bind Menubutton <space>]
bind $data(w:menubutton) <Down> [bind Menubutton <space>]}
proc txOption::config-state {w state} {upvar #0 $w data
$data(w:menubutton) config -state $state}
proc txOption::config-width {w wid} {upvar #0 $w data
$data(w:menubutton) config -width $wid}
proc txOption::add {w name args} {upvar #0 $w data
if [info exists data($name,index)] {error "item $name already exists in the option menu $w"}
set validOptions {-command -label}
set opt(-command) {}
set opt(-label) $name
tixHandleOptions -nounknown opt $validOptions $args
if {$opt(-command) != {}} {error "option -command cannot be specified"}
eval $data(w:menu) add command $args [list -label $opt(-label) -command "txOption::invoke $w \{$name\}"]
set index $data(nItems)
set data($index,name) $name
set data($name,label) $opt(-label)
set data($name,index) $index
if {$index == 0} {$data(w:menubutton) config -text $data($name,label)
set data(value) $name
set mod $data(-modified)
txOption::invoke $w $name
set data(-modified) $mod}
incr data(nItems)}
proc txOption::set {w name} {upvar #0 $w data
set label $data($name,label)
if { $label=={} } {set label $name}
$data(w:menubutton) config -text $label
set data(value) $name}
proc txOption::get { w } {upvar #0 $w data
return $data(value)}
proc txOption::invoke {w name} {upvar #0 $w data
if { $data(-state) == "normal"} {set data(-modified) 1
if [info exists data($name,index)] {$data(w:menubutton) config -text $data($name,label)
set data(value) $name
if {$data(-command) != {} } {Require tclkit 3
set cmd [Replace $data(-command) [list "%i=$data($name,index)" "%n=$name" "%t=$data($name,label)" "%w=$w" "%e=$data(w:menubutton)" ]]
eval $cmd}} else {error "item '$name' does not exist"}}}
# +EOF